home *** CD-ROM | disk | FTP | other *** search
/ The Amiga Classic Collection / The Amiga Classic Collection - Disc 1.iso / Education / ED05-AmRadio1.DMS / ED05-AmRadio1.adf / Logging / WPX / WPX.Dupe (.txt) < prev    next >
AmigaBASIC Source Code  |  1988-01-19  |  10KB  |  285 lines
  1. '{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{{
  2. '   WPX  C O N T E S T - D U P E  &  S A V E    P R O G R A M
  3. '          by Bj. Madsen - VE5FX      Nov. 11, 1986
  4. '}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}}
  5.  
  6. ' This program is designed for the CQ-WW-WPX Contest.  It will allow input
  7. ' of callsigns for contest duping purposes, duping for match per band.
  8. ' It also checks PREFIXES for dupe, and informs you if a new prefix
  9. ' has been worked.  A total is displayed of QSOs per band as well as
  10. ' total number of prefixes for combined bands for the contest.  It also tests
  11. ' for valid callsigns, requiring both numbers and letters and allowing
  12. ' for the inclusion of a slash.   A NEW callsign will provide
  13. ' a choice of whether to save or pass.  Callsigns will be saved to a
  14. ' pre-defined disk file every 20 entries or whenever the command <SAVE>
  15. ' is entered in place of a callsign.  At the end of a band-session, enter
  16. ' the word <END>.  Outstanding calls will be saved and the program will end.
  17. ' New prefixes worked will be added to the PREFIXES file, and loaded again
  18. ' when the new band-file is loaded or established. 
  19.  
  20.  
  21.  CLEAR ,100000
  22.  DEFINT K-Z
  23.   DIM M$(21) : DIM Z$(21) : DIM TPX$(21) :DIM PX$(2000)
  24.   DIM A$(400):DIM b$(400): DIM C$(500): DIM D$(500): DIM E$(400)
  25.   DIM F$(400): DIM G$(400): DIM H$(400): DIM I$(400): DIM J$(400) 
  26.    CLS:WINDOW 1, "WPX CONTEST DUPING PROGRAM ",(0,0)-(610,185),15
  27.    
  28.   TITLE: '----------------------------------------------------Title for menu
  29.     LINE (0,0)-(640,5),3,bf
  30.     LINE (0,0)-(10,200),3,bf
  31.     LINE (607,0)-(617,200),3,bf
  32.     LINE (0,181)-(617,186),3,bf
  33.     LINE (0,30)-(640,35),3,b
  34.     PAINT (20,10),2,3
  35.     PAINT (20,33),1,3
  36.     COLOR 3,2
  37.     LOCATE 3,25:PRINT " W P X   CONTEST DUPER "
  38.     COLOR 2,3 :PRINT :PRINT 
  39.     PRINT :PRINT :PRINT TAB(10)"  To save fewer than 20 calls to disk, enter the word <SAVE>  "
  40.     PRINT TAB(22)"  rather than the regular callsign..... "
  41.     PRINT:PRINT TAB(15)"====>  shift NOW to UPPER CASE LETTERS  <===="
  42.    
  43.     COLOR 1,0
  44.     PRINT :PRINT :PRINT TAB(15)"Are there calls to be entered from a disk file";:INPUT A$
  45.        IF LEFT$(A$,1) = "Y" OR LEFT$(A$,1) = "y" THEN GOTO LOAD.CALLS
  46. '-------------------------------------------------------Create a file on disk
  47.     PRINT :PRINT :PRINT  TAB(15)"What filename do you wish to use";:INPUT DUPEFILE$
  48.      PRINT :COLOR 2,3:PRINT TAB(15)" Creating output file named: ";DUPEFILE$ :COLOR 1,0
  49.       OPEN DUPEFILE$ FOR OUTPUT AS #1 
  50.       CLOSE #1 : QP$=""
  51.       PRINT :PRINT TAB(15)"Do you wish to CREATE a new PREFIX FILE";:INPUT QP$  
  52.         IF QP$ = "YES" THEN
  53.            COLOR 2,3
  54.            PRINT :PRINT TAB(15) " Creating PREFIXES file: "
  55.            COLOR 1,0
  56.            OPEN "PREFIXES" FOR OUTPUT AS #1
  57.            CLOSE #1
  58.         ELSE
  59.            GOTO LOAD.PFX
  60.         END IF
  61. '--------------------------------------------------------Set up input windows
  62. SET.WINDOW:
  63.    CLS
  64.     WINDOW 1,"CONTACTS MADE:",(160,30)-(440,185),2
  65.     WINDOW 3,"PREFIX DATA:",(100,16)-(510,26),2
  66.     WINDOW 2,"WPX Contest at VE5FX: ",(1,1)-(610,10),2
  67.  
  68. DATA.ENTRY:   '---------------------------------------Get callsign for entry
  69.       WINDOW OUTPUT 3 : COLOR 2,1 : CLS
  70.       PRINT TAB(10)" Total Prefixes worked: ";PX;
  71.       WINDOW OUTPUT 2 : COLOR 1,2: CLS
  72.       INPUT"  What is the callsign.....";CS$
  73.       IF CS$ = "SAVE" OR CS$ = "END" THEN GOSUB SAVE.PFX: GOSUB  SAVE.TO.DISK: GOTO DATA.ENTRY
  74.       
  75. '-------------------------------------------------Check callsign for validity
  76.     N=0 : P=0 : L=0
  77.     FOR V = 2 TO LEN(CS$)
  78.       X$ = MID$(CS$,V,1)
  79.         IF X$<"/" OR X$>"9" AND X$<"A" OR X$>"Z" THEN N=N+1
  80.          IF (X$>"/") AND (X$<":") AND (P = 0) THEN P=V      'finds first number
  81.         IF X$>"@" AND X$<"[" THEN L=V
  82.      NEXT V   
  83.         IF (N>0) OR (P=0) OR (L=0) THEN GOTO FLASH
  84.      ON VAL(MID$(CS$,P,1)) GOTO ONE,TWO,THREE,FOUR,FIVE,SIX,SEVEN,EIGHT,NINE  
  85.      IF VAL(MID$(CS$,P,1))=0 THEN ZERO
  86.      
  87. FLASH:     '-------------------Data entry error message for invalid callsigns
  88.   WINDOW OUTPUT 2: COLOR 1,2
  89.     FOR V = 1 TO 10
  90.      BEEP
  91.      PRINT TAB(10)">>>>> I N V A L I D    C A L L S I G N <<<<<"
  92.     NEXT V
  93.   GOTO DATA.ENTRY 
  94.  
  95. '-------------------------------------------------------- Save callsigns, etc. 
  96. ONE:
  97.   FOR X=1 TO A
  98.     IF A$(X) = CS$ THEN K$=A$(X): GOTO DUPE.TELL
  99.   NEXT X  
  100.     GOSUB PREFIX:GOSUB SAVE.CALL
  101.     IF C$="S" THEN A=A+1: A$(A)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,A$(A),A
  102.   GOTO DATA.ENTRY
  103.   
  104. TWO:
  105.     FOR X=1 TO b
  106.     IF b$(X) = CS$ THEN K$=b$(X): GOTO DUPE.TELL
  107.   NEXT X  
  108.     GOSUB PREFIX:GOSUB SAVE.CALL
  109.     IF C$="S" THEN b=b+1: b$(b)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,b$(b),b
  110.   GOTO DATA.ENTRY
  111.    
  112. THREE:
  113.   FOR X=1 TO C
  114.     IF C$(X) = CS$ THEN K$=C$(X): GOTO DUPE.TELL
  115.   NEXT X  
  116.     GOSUB PREFIX:GOSUB SAVE.CALL
  117.     IF C$="S" THEN C=C+1: C$(C)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,C$(C),C
  118.   GOTO DATA.ENTRY
  119.  
  120. FOUR:
  121.   FOR X=1 TO D
  122.     IF D$(X) = CS$ THEN K$=D$(X): GOTO DUPE.TELL
  123.   NEXT X  
  124.     GOSUB PREFIX:GOSUB SAVE.CALL
  125.     IF C$="S" THEN D=D+1: D$(D)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,D$(D),D
  126.   GOTO DATA.ENTRY
  127.  
  128. FIVE:
  129.   FOR X=1 TO E
  130.     IF E$(X) = CS$ THEN K$=E$(X): GOTO DUPE.TELL
  131.   NEXT X  
  132.     GOSUB PREFIX:GOSUB SAVE.CALL
  133.     IF C$="S" THEN E=E+1: E$(E)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,E$(E),E
  134.   GOTO DATA.ENTRY
  135.  
  136. SIX:
  137.   FOR X=1 TO F
  138.     IF F$(X) = CS$ THEN K$=F$(X): GOTO DUPE.TELL
  139.   NEXT X  
  140.     GOSUB PREFIX:GOSUB SAVE.CALL
  141.     IF C$="S" THEN F=F+1: F$(F)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,F$(F),F
  142.   GOTO DATA.ENTRY
  143.  
  144. SEVEN:
  145.   FOR X=1 TO G
  146.     IF G$(X) = CS$ THEN K$=G$(X): GOTO DUPE.TELL
  147.   NEXT X  
  148.     GOSUB PREFIX:GOSUB SAVE.CALL
  149.     IF C$="S" THEN G=G+1: G$(G)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,G$(G),G
  150.   GOTO DATA.ENTRY
  151.  
  152. EIGHT: 
  153.   FOR X=1 TO H
  154.     IF H$(X) = CS$ THEN K$=H$(X): GOTO DUPE.TELL
  155.   NEXT X  
  156.     GOSUB PREFIX:GOSUB SAVE.CALL
  157.     IF C$="S" THEN H=H+1: H$(H)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,H$(H),H
  158.   GOTO DATA.ENTRY
  159.  
  160. NINE:
  161.   FOR X=1 TO I
  162.     IF I$(X) = CS$ THEN K$=I$(X): GOTO DUPE.TELL
  163.   NEXT X  
  164.     GOSUB PREFIX:GOSUB SAVE.CALL
  165.     IF C$="S" THEN I=I+1: I$(I)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,I$(I),I
  166.   GOTO DATA.ENTRY
  167.  
  168. ZERO:
  169.   FOR X=1 TO J
  170.     IF J$(X) = CS$ THEN K$=J$(X): GOTO DUPE.TELL
  171.   NEXT X  
  172.     GOSUB PREFIX:GOSUB SAVE.CALL
  173.     IF C$="S" THEN J=J+1: J$(J)=CS$:WINDOW OUTPUT 1: COLOR 1,0: PRINT A+b+C+D+E+F+G+H+I+J,J$(J),J
  174.   GOTO DATA.ENTRY
  175.    
  176. DUPE.TELL:     '------------------------------------------------ dupe message
  177.    WINDOW OUTPUT 2: COLOR 2,1
  178.    FOR V=1 TO 10: BEEP
  179.      PRINT TAB(10) "  DUPE ==> ";K$;" is already on file.....  ";
  180.    NEXT V: GOTO DATA.ENTRY 
  181.  
  182. SAVE.CALL:          '------------------------------Make choice - save or pass
  183.    WINDOW OUTPUT 2: COLOR 2,1
  184.       PRINT TAB(15)"  " CS$;" is a new call...<S>ave or <P>ass?  ";
  185.     LOOP:
  186.      C$=INKEY$
  187.        IF C$ = "S" THEN 
  188.          M=M+1
  189.          M$(M)=CS$
  190.            IF DUPE = 0 THEN
  191.              PX=PX+1
  192.              PX$(PX)=LEFT$(CS$,P)
  193.              NPX=NPX+1
  194.              TPX$(NPX)=PX$(PX)
  195.            END IF
  196.        END IF
  197.        IF M = 20 THEN GOSUB SAVE.TO.DISK: RETURN
  198.        IF C$ = "S" THEN RETURN
  199.        IF C$ = "P" THEN RETURN
  200.      GOTO LOOP
  201. PREFIX:     '------------------------------------------------Dupe for prefix
  202.    DUPE = 0 
  203.    FOR Y = 1 TO PX
  204.      IF PX$(Y) = LEFT$(CS$,P) THEN DUPE = 1 
  205.    NEXT Y 
  206.    IF DUPE = 1 THEN 
  207.       WINDOW OUTPUT 3
  208.       CLS:COLOR 3,1
  209.       PRINT TAB(12)"  ";LEFT$(CS$,P);" is already on file";
  210.    END IF
  211.    IF DUPE = 0 THEN
  212.       WINDOW OUTPUT 3
  213.       CLS:COLOR 3,1
  214.       PRINT TAB(10)"[[[[[ ";
  215.       COLOR 1,2:PRINT " "LEFT$(CS$,P)" ";
  216.       COLOR 3,1:PRINT " ]]]]] is a NEW PREFIX !!";
  217.    END IF
  218.    IF NPX = 20 THEN GOSUB SAVE.PFX
  219.   RETURN 
  220.   
  221. SAVE.PFX:       '------------------------------------save 20 prefixes to disk
  222.    WINDOW OUTPUT 1: COLOR 3,0
  223.    PRINT "Saving ";NPX;" prefixes to disk"
  224.    OPEN "A",#1,"PREFIXES"
  225.       FOR V=1 TO NPX
  226.          PRINT #1,TPX$(V)
  227.       NEXT V
  228.     CLOSE #1:NPX=0 :COLOR 1,0
  229.    RETURN
  230.      
  231. SAVE.TO.DISK:     '-----------------------save 20 calls or fewer to disk file
  232.   WINDOW OUTPUT 1: COLOR 3,0
  233.   PRINT "Saving ";M;" calls to file: ";DUPEFILE$
  234.     OPEN "A",#1, DUPEFILE$
  235.       FOR V=1 TO M
  236.          PRINT #1, M$(V)
  237.       NEXT V
  238.     CLOSE #1: M=0 : COLOR 1,0
  239.    IF CS$ = "END" THEN END :ELSE RETURN
  240.     
  241. LOAD.CALLS: '--------------------------load previously created file from disk
  242.   PRINT :PRINT :PRINT TAB(15)"What filename do you wish to load";:INPUT DUPEFILE$
  243.   OPEN "I",#1,DUPEFILE$
  244.    WHILE NOT EOF(1)
  245.     INPUT #1, CS$
  246.       FOR V=1 TO LEN(CS$)
  247.         X$=MID$(CS$,V,1)
  248.         IF X$>"/" AND X$<":" THEN N=VAL(X$)    'N is value of last number
  249.       NEXT V
  250.     
  251.       ON N GOTO WON,TOO,THR,FER,FIV,SEX,SEV,ATE,NIN
  252.       IF N = 0 THEN DIX
  253.     WON:  A=A+1: A$(A)=CS$: GOTO LAST
  254.     TOO:  b=b+1: b$(b)=CS$: GOTO LAST
  255.     THR:  C=C+1: C$(C)=CS$: GOTO LAST
  256.     FER:  D=D+1: D$(D)=CS$: GOTO LAST 
  257.     FIV:  E=E+1: E$(E)=CS$: GOTO LAST
  258.     SEX:  F=F+1: F$(F)=CS$: GOTO LAST
  259.     SEV:  G=G+1: G$(G)=CS$: GOTO LAST
  260.     ATE:  H=H+1: H$(H)=CS$: GOTO LAST
  261.     NIN:  I=I+1: I$(I)=CS$: GOTO LAST
  262.     DIX:  J=J+1: J$(J)=CS$: GOTO LAST
  263.     LAST:
  264.   WEND
  265.    CLOSE #1: COLOR 0,3
  266. LOAD.PFX:   '------------------------------------------- Read in prefix file 
  267. OPEN "I",#1,"PREFIXES"
  268.   WHILE NOT EOF(1)
  269.     PX = PX + 1
  270.      INPUT #1,PX$(PX)
  271.   WEND
  272.   CLOSE #1
  273.    PRINT 
  274.    PRINT TAB(10) " A total of ";A+b+C+D+E+F+G+H+I+J;" callsigns in ";DUPEFILE$
  275.    PRINT :PRINT TAB(10) " and a total of ";PX;" Prefixes worked so far... "
  276.    COLOR 3,0:PRINT :PRINT 
  277.    PRINT TAB(20)"Press <RETURN> to continue.....";:INPUT C$
  278.   GOTO SET.WINDOW
  279.   
  280.     
  281.     
  282.     
  283.     
  284.     
  285.